home *** CD-ROM | disk | FTP | other *** search
/ Chip 1997 January / CHIP Turkiye Ocak 1997.iso / program / sound / amod30 / txt3d.pas < prev   
Pascal/Delphi Source File  |  1995-08-11  |  26KB  |  796 lines
  1. unit txt3d;
  2. interface
  3. const
  4.   scr_seg : word = $a000;
  5.  
  6. type
  7. t_matrix = array[0..8] of longint;
  8.  
  9. var
  10. matrix : t_matrix;
  11.  
  12. procedure matriisi(var mat : t_matrix;kx2,ky2,kz2 : integer);
  13. procedure rotatep;
  14. procedure line3(x1,y1,x2,y2 : integer;color : byte);
  15. procedure mix;
  16. procedure show;
  17. procedure hide;
  18. procedure setfont;
  19. procedure l3d_cube;
  20. procedure l3d_pyramid;
  21. procedure l3d_adnmod;
  22. procedure l3d_asm95;
  23. procedure init3d;
  24.  
  25. implementation
  26. const
  27.   fontti_POINTS=$08;
  28.   fontti : ARRAY [1..$0800] OF CHAR = (
  29.     #$00, #$00, #$00, #$00, #$00, #$00, #$00, #$00, 
  30.     #$7E, #$81, #$A5, #$81, #$BD, #$99, #$81, #$7E, 
  31.     #$7E, #$FF, #$DB, #$FF, #$C3, #$E7, #$FF, #$7E, 
  32.     #$6C, #$FE, #$FE, #$FE, #$7C, #$38, #$10, #$00, 
  33.     #$10, #$38, #$7C, #$FE, #$7C, #$38, #$10, #$00, 
  34.     #$38, #$7C, #$38, #$FE, #$FE, #$7C, #$38, #$7C, 
  35.     #$10, #$10, #$38, #$7C, #$FE, #$7C, #$38, #$7C, 
  36.     #$00, #$00, #$18, #$3C, #$3C, #$18, #$00, #$00, 
  37.     #$FF, #$FF, #$E7, #$C3, #$C3, #$E7, #$FF, #$FF, 
  38.     #$00, #$3C, #$66, #$42, #$42, #$66, #$3C, #$00, 
  39.     #$FF, #$C3, #$99, #$BD, #$BD, #$99, #$C3, #$FF, 
  40.     #$0F, #$07, #$0F, #$7D, #$CC, #$CC, #$CC, #$78, 
  41.     #$3C, #$66, #$66, #$66, #$3C, #$18, #$7E, #$18, 
  42.     #$3F, #$33, #$3F, #$30, #$30, #$70, #$F0, #$E0, 
  43.     #$7F, #$63, #$7F, #$63, #$63, #$67, #$E6, #$C0, 
  44.     #$99, #$5A, #$3C, #$E7, #$E7, #$3C, #$5A, #$99, 
  45.     #$80, #$E0, #$F8, #$FE, #$F8, #$E0, #$80, #$00, 
  46.     #$02, #$0E, #$3E, #$FE, #$3E, #$0E, #$02, #$00, 
  47.     #$18, #$3C, #$7E, #$18, #$18, #$7E, #$3C, #$18, 
  48.     #$66, #$66, #$66, #$66, #$66, #$00, #$66, #$00, 
  49.     #$7F, #$DB, #$DB, #$7B, #$1B, #$1B, #$1B, #$00, 
  50.     #$3E, #$63, #$38, #$6C, #$6C, #$38, #$CC, #$78, 
  51.     #$00, #$00, #$00, #$00, #$7E, #$7E, #$7E, #$00, 
  52.     #$18, #$3C, #$7E, #$18, #$7E, #$3C, #$18, #$FF, 
  53.     #$18, #$3C, #$7E, #$18, #$18, #$18, #$18, #$00, 
  54.     #$18, #$18, #$18, #$18, #$7E, #$3C, #$18, #$00, 
  55.     #$00, #$18, #$0C, #$FE, #$0C, #$18, #$00, #$00, 
  56.     #$00, #$30, #$60, #$FE, #$60, #$30, #$00, #$00, 
  57.     #$00, #$00, #$C0, #$C0, #$C0, #$FE, #$00, #$00, 
  58.     #$00, #$24, #$66, #$FF, #$66, #$24, #$00, #$00, 
  59.     #$00, #$18, #$3C, #$7E, #$FF, #$FF, #$00, #$00, 
  60.     #$00, #$FF, #$FF, #$7E, #$3C, #$18, #$00, #$00, 
  61.     #$00, #$00, #$00, #$00, #$00, #$00, #$00, #$00, 
  62.     #$30, #$78, #$78, #$78, #$30, #$00, #$30, #$00, 
  63.     #$6C, #$6C, #$6C, #$00, #$00, #$00, #$00, #$00, 
  64.     #$6C, #$6C, #$FE, #$6C, #$FE, #$6C, #$6C, #$00, 
  65.     #$30, #$7C, #$C0, #$78, #$0C, #$F8, #$30, #$00, 
  66.     #$00, #$C6, #$CC, #$18, #$30, #$66, #$C6, #$00, 
  67.     #$38, #$6C, #$38, #$76, #$DC, #$CC, #$76, #$00, 
  68.     #$60, #$60, #$C0, #$00, #$00, #$00, #$00, #$00, 
  69.     #$18, #$30, #$60, #$60, #$60, #$30, #$18, #$00, 
  70.     #$60, #$30, #$18, #$18, #$18, #$30, #$60, #$00, 
  71.     #$00, #$66, #$3C, #$FF, #$3C, #$66, #$00, #$00, 
  72.     #$00, #$30, #$30, #$FC, #$30, #$30, #$00, #$00, 
  73.     #$00, #$00, #$00, #$00, #$00, #$30, #$30, #$60, 
  74.     #$00, #$00, #$00, #$FC, #$00, #$00, #$00, #$00, 
  75.     #$00, #$00, #$00, #$00, #$00, #$30, #$30, #$00, 
  76.     #$06, #$0C, #$18, #$30, #$60, #$C0, #$80, #$00, 
  77.     #$7C, #$C6, #$CE, #$DE, #$F6, #$E6, #$7C, #$00, 
  78.     #$30, #$70, #$30, #$30, #$30, #$30, #$FC, #$00, 
  79.     #$78, #$CC, #$0C, #$38, #$60, #$CC, #$FC, #$00, 
  80.     #$78, #$CC, #$0C, #$38, #$0C, #$CC, #$78, #$00, 
  81.     #$1C, #$3C, #$6C, #$CC, #$FE, #$0C, #$1E, #$00, 
  82.     #$FC, #$C0, #$F8, #$0C, #$0C, #$CC, #$78, #$00, 
  83.     #$38, #$60, #$C0, #$F8, #$CC, #$CC, #$78, #$00, 
  84.     #$FC, #$CC, #$0C, #$18, #$30, #$30, #$30, #$00, 
  85.     #$78, #$CC, #$CC, #$78, #$CC, #$CC, #$78, #$00, 
  86.     #$78, #$CC, #$CC, #$7C, #$0C, #$18, #$70, #$00, 
  87.     #$00, #$30, #$30, #$00, #$00, #$30, #$30, #$00, 
  88.     #$00, #$30, #$30, #$00, #$00, #$30, #$30, #$60, 
  89.     #$18, #$30, #$60, #$C0, #$60, #$30, #$18, #$00, 
  90.     #$00, #$00, #$FC, #$00, #$00, #$FC, #$00, #$00, 
  91.     #$60, #$30, #$18, #$0C, #$18, #$30, #$60, #$00, 
  92.     #$78, #$CC, #$0C, #$18, #$30, #$00, #$30, #$00, 
  93.     #$7C, #$C6, #$DE, #$DE, #$DE, #$C0, #$78, #$00, 
  94.     #$30, #$78, #$CC, #$CC, #$FC, #$CC, #$CC, #$00, 
  95.     #$FC, #$66, #$66, #$7C, #$66, #$66, #$FC, #$00, 
  96.     #$3C, #$66, #$C0, #$C0, #$C0, #$66, #$3C, #$00, 
  97.     #$F8, #$6C, #$66, #$66, #$66, #$6C, #$F8, #$00, 
  98.     #$7E, #$60, #$60, #$78, #$60, #$60, #$7E, #$00, 
  99.     #$7E, #$60, #$60, #$78, #$60, #$60, #$60, #$00, 
  100.     #$3C, #$66, #$C0, #$C0, #$CE, #$66, #$3E, #$00, 
  101.     #$CC, #$CC, #$CC, #$FC, #$CC, #$CC, #$CC, #$00, 
  102.     #$78, #$30, #$30, #$30, #$30, #$30, #$78, #$00, 
  103.     #$1E, #$0C, #$0C, #$0C, #$CC, #$CC, #$78, #$00, 
  104.     #$E6, #$66, #$6C, #$78, #$6C, #$66, #$E6, #$00, 
  105.     #$60, #$60, #$60, #$60, #$60, #$60, #$7E, #$00, 
  106.     #$C6, #$EE, #$FE, #$FE, #$D6, #$C6, #$C6, #$00, 
  107.     #$C6, #$E6, #$F6, #$DE, #$CE, #$C6, #$C6, #$00, 
  108.     #$38, #$6C, #$C6, #$C6, #$C6, #$6C, #$38, #$00, 
  109.     #$FC, #$66, #$66, #$7C, #$60, #$60, #$F0, #$00, 
  110.     #$78, #$CC, #$CC, #$CC, #$DC, #$78, #$1C, #$00, 
  111.     #$FC, #$66, #$66, #$7C, #$6C, #$66, #$E6, #$00, 
  112.     #$78, #$CC, #$E0, #$70, #$1C, #$CC, #$78, #$00, 
  113.     #$FC, #$30, #$30, #$30, #$30, #$30, #$30, #$00, 
  114.     #$CC, #$CC, #$CC, #$CC, #$CC, #$CC, #$FC, #$00, 
  115.     #$CC, #$CC, #$CC, #$CC, #$CC, #$78, #$30, #$00, 
  116.     #$C6, #$C6, #$C6, #$D6, #$FE, #$EE, #$C6, #$00, 
  117.     #$C6, #$C6, #$6C, #$38, #$38, #$6C, #$C6, #$00, 
  118.     #$CC, #$CC, #$CC, #$78, #$30, #$30, #$78, #$00, 
  119.     #$FE, #$06, #$0C, #$18, #$30, #$60, #$FE, #$00, 
  120.     #$78, #$60, #$60, #$60, #$60, #$60, #$78, #$00, 
  121.     #$C0, #$60, #$30, #$18, #$0C, #$06, #$02, #$00, 
  122.     #$78, #$18, #$18, #$18, #$18, #$18, #$78, #$00, 
  123.     #$10, #$38, #$6C, #$C6, #$00, #$00, #$00, #$00, 
  124.     #$00, #$00, #$00, #$00, #$00, #$00, #$00, #$FF, 
  125.     #$30, #$30, #$18, #$00, #$00, #$00, #$00, #$00, 
  126.     #$00, #$00, #$78, #$0C, #$7C, #$CC, #$76, #$00, 
  127.     #$E0, #$60, #$60, #$7C, #$66, #$66, #$DC, #$00, 
  128.     #$00, #$00, #$78, #$CC, #$C0, #$CC, #$78, #$00, 
  129.     #$1C, #$0C, #$0C, #$7C, #$CC, #$CC, #$76, #$00, 
  130.     #$00, #$00, #$78, #$CC, #$FC, #$C0, #$78, #$00, 
  131.     #$38, #$6C, #$60, #$F0, #$60, #$60, #$F0, #$00, 
  132.     #$00, #$00, #$76, #$CC, #$CC, #$7C, #$0C, #$F8, 
  133.     #$E0, #$60, #$6C, #$76, #$66, #$66, #$E6, #$00, 
  134.     #$30, #$00, #$70, #$30, #$30, #$30, #$78, #$00, 
  135.     #$0C, #$00, #$0C, #$0C, #$0C, #$CC, #$CC, #$78, 
  136.     #$E0, #$60, #$66, #$6C, #$78, #$6C, #$E6, #$00, 
  137.     #$70, #$30, #$30, #$30, #$30, #$30, #$78, #$00, 
  138.     #$00, #$00, #$CC, #$FE, #$FE, #$D6, #$C6, #$00, 
  139.     #$00, #$00, #$F8, #$CC, #$CC, #$CC, #$CC, #$00, 
  140.     #$00, #$00, #$78, #$CC, #$CC, #$CC, #$78, #$00, 
  141.     #$00, #$00, #$DC, #$66, #$66, #$7C, #$60, #$F0, 
  142.     #$00, #$00, #$76, #$CC, #$CC, #$7C, #$0C, #$1E, 
  143.     #$00, #$00, #$DC, #$76, #$66, #$60, #$F0, #$00, 
  144.     #$00, #$00, #$7C, #$C0, #$78, #$0C, #$F8, #$00, 
  145.     #$10, #$30, #$7C, #$30, #$30, #$34, #$18, #$00, 
  146.     #$00, #$00, #$CC, #$CC, #$CC, #$CC, #$76, #$00, 
  147.     #$00, #$00, #$CC, #$CC, #$CC, #$78, #$30, #$00, 
  148.     #$00, #$00, #$C6, #$D6, #$FE, #$FE, #$6C, #$00, 
  149.     #$00, #$00, #$C6, #$6C, #$38, #$6C, #$C6, #$00, 
  150.     #$00, #$00, #$CC, #$CC, #$CC, #$7C, #$0C, #$F8, 
  151.     #$00, #$00, #$FC, #$98, #$30, #$64, #$FC, #$00, 
  152.     #$1C, #$30, #$30, #$E0, #$30, #$30, #$1C, #$00, 
  153.     #$18, #$18, #$18, #$00, #$18, #$18, #$18, #$00, 
  154.     #$E0, #$30, #$30, #$1C, #$30, #$30, #$E0, #$00, 
  155.     #$76, #$DC, #$00, #$00, #$00, #$00, #$00, #$00, 
  156.     #$00, #$10, #$38, #$6C, #$C6, #$C6, #$FE, #$00, 
  157.     #$78, #$CC, #$C0, #$CC, #$78, #$18, #$0C, #$78, 
  158.     #$00, #$CC, #$00, #$CC, #$CC, #$CC, #$7E, #$00, 
  159.     #$1C, #$00, #$78, #$CC, #$FC, #$C0, #$78, #$00, 
  160.     #$7E, #$C3, #$3C, #$06, #$3E, #$66, #$3F, #$00, 
  161.     #$CC, #$00, #$78, #$0C, #$7C, #$CC, #$7E, #$00, 
  162.     #$E0, #$00, #$78, #$0C, #$7C, #$CC, #$7E, #$00, 
  163.     #$30, #$30, #$78, #$0C, #$7C, #$CC, #$7E, #$00, 
  164.     #$00, #$00, #$78, #$C0, #$C0, #$78, #$0C, #$38, 
  165.     #$7E, #$C3, #$3C, #$66, #$7E, #$60, #$3C, #$00, 
  166.     #$CC, #$00, #$78, #$CC, #$FC, #$C0, #$78, #$00, 
  167.     #$E0, #$00, #$78, #$CC, #$FC, #$C0, #$78, #$00, 
  168.     #$CC, #$00, #$70, #$30, #$30, #$30, #$78, #$00, 
  169.     #$7C, #$C6, #$38, #$18, #$18, #$18, #$3C, #$00, 
  170.     #$E0, #$00, #$70, #$30, #$30, #$30, #$78, #$00, 
  171.     #$C6, #$38, #$6C, #$C6, #$FE, #$C6, #$C6, #$00, 
  172.     #$30, #$30, #$00, #$78, #$CC, #$FC, #$CC, #$00, 
  173.     #$1C, #$00, #$FC, #$60, #$78, #$60, #$FC, #$00, 
  174.     #$00, #$00, #$7F, #$0C, #$7F, #$CC, #$7F, #$00, 
  175.     #$3E, #$6C, #$CC, #$FE, #$CC, #$CC, #$CE, #$00, 
  176.     #$78, #$CC, #$00, #$78, #$CC, #$CC, #$78, #$00, 
  177.     #$00, #$CC, #$00, #$78, #$CC, #$CC, #$78, #$00, 
  178.     #$00, #$E0, #$00, #$78, #$CC, #$CC, #$78, #$00, 
  179.     #$78, #$CC, #$00, #$CC, #$CC, #$CC, #$7E, #$00, 
  180.     #$00, #$E0, #$00, #$CC, #$CC, #$CC, #$7E, #$00, 
  181.     #$00, #$CC, #$00, #$CC, #$CC, #$7C, #$0C, #$F8, 
  182.     #$C3, #$18, #$3C, #$66, #$66, #$3C, #$18, #$00, 
  183.     #$CC, #$00, #$CC, #$CC, #$CC, #$CC, #$78, #$00, 
  184.     #$18, #$18, #$7E, #$C0, #$C0, #$7E, #$18, #$18, 
  185.     #$38, #$6C, #$64, #$F0, #$60, #$E6, #$FC, #$00, 
  186.     #$CC, #$CC, #$78, #$FC, #$30, #$FC, #$30, #$30, 
  187.     #$F8, #$CC, #$CC, #$FA, #$C6, #$CF, #$C6, #$C7, 
  188.     #$0E, #$1B, #$18, #$3C, #$18, #$18, #$D8, #$70, 
  189.     #$00, #$00, #$00, #$00, #$00, #$00, #$00, #$00, 
  190.     #$F0, #$F0, #$F0, #$F0, #$00, #$00, #$00, #$00, 
  191.     #$0F, #$0F, #$0F, #$0F, #$00, #$00, #$00, #$00, 
  192.     #$FF, #$FF, #$FF, #$FF, #$00, #$00, #$00, #$00, 
  193.     #$00, #$00, #$00, #$00, #$F0, #$F0, #$F0, #$F0, 
  194.     #$F0, #$F0, #$F0, #$F0, #$F0, #$F0, #$F0, #$F0, 
  195.     #$0F, #$0F, #$0F, #$0F, #$F0, #$F0, #$F0, #$F0, 
  196.     #$FF, #$FF, #$FF, #$FF, #$F0, #$F0, #$F0, #$F0, 
  197.     #$00, #$00, #$00, #$00, #$0F, #$0F, #$0F, #$0F, 
  198.     #$F0, #$F0, #$F0, #$F0, #$0F, #$0F, #$0F, #$0F, 
  199.     #$0F, #$0F, #$0F, #$0F, #$0F, #$0F, #$0F, #$0F, 
  200.     #$FF, #$FF, #$FF, #$FF, #$0F, #$0F, #$0F, #$0F, 
  201.     #$00, #$00, #$00, #$00, #$FF, #$FF, #$FF, #$FF, 
  202.     #$F0, #$F0, #$F0, #$F0, #$FF, #$FF, #$FF, #$FF, 
  203.     #$0F, #$0F, #$0F, #$0F, #$FF, #$FF, #$FF, #$FF, 
  204.     #$FF, #$FF, #$FF, #$FF, #$FF, #$FF, #$FF, #$FF, 
  205.     #$22, #$88, #$22, #$88, #$22, #$88, #$22, #$88, 
  206.     #$55, #$AA, #$55, #$AA, #$55, #$AA, #$55, #$AA, 
  207.     #$DB, #$77, #$DB, #$EE, #$DB, #$77, #$DB, #$EE, 
  208.     #$18, #$18, #$18, #$18, #$18, #$18, #$18, #$18, 
  209.     #$18, #$18, #$18, #$18, #$F8, #$18, #$18, #$18, 
  210.     #$18, #$18, #$F8, #$18, #$F8, #$18, #$18, #$18, 
  211.     #$36, #$36, #$36, #$36, #$F6, #$36, #$36, #$36, 
  212.     #$00, #$00, #$00, #$00, #$FE, #$36, #$36, #$36, 
  213.     #$00, #$00, #$F8, #$18, #$F8, #$18, #$18, #$18, 
  214.     #$36, #$36, #$F6, #$06, #$F6, #$36, #$36, #$36, 
  215.     #$36, #$36, #$36, #$36, #$36, #$36, #$36, #$36, 
  216.     #$00, #$00, #$FE, #$06, #$F6, #$36, #$36, #$36, 
  217.     #$36, #$36, #$F6, #$06, #$FE, #$00, #$00, #$00, 
  218.     #$36, #$36, #$36, #$36, #$FE, #$00, #$00, #$00, 
  219.     #$18, #$18, #$F8, #$18, #$F8, #$00, #$00, #$00, 
  220.     #$00, #$00, #$00, #$00, #$F8, #$18, #$18, #$18, 
  221.     #$18, #$18, #$18, #$18, #$1F, #$00, #$00, #$00, 
  222.     #$18, #$18, #$18, #$18, #$FF, #$00, #$00, #$00, 
  223.     #$00, #$00, #$00, #$00, #$FF, #$18, #$18, #$18, 
  224.     #$18, #$18, #$18, #$18, #$1F, #$18, #$18, #$18, 
  225.     #$00, #$00, #$00, #$00, #$FF, #$00, #$00, #$00, 
  226.     #$18, #$18, #$18, #$18, #$FF, #$18, #$18, #$18, 
  227.     #$18, #$18, #$1F, #$18, #$1F, #$18, #$18, #$18, 
  228.     #$36, #$36, #$36, #$36, #$37, #$36, #$36, #$36, 
  229.     #$36, #$36, #$37, #$30, #$3F, #$00, #$00, #$00, 
  230.     #$00, #$00, #$3F, #$30, #$37, #$36, #$36, #$36, 
  231.     #$36, #$36, #$F7, #$00, #$FF, #$00, #$00, #$00, 
  232.     #$00, #$00, #$FF, #$00, #$F7, #$36, #$36, #$36, 
  233.     #$36, #$36, #$37, #$30, #$37, #$36, #$36, #$36, 
  234.     #$00, #$00, #$FF, #$00, #$FF, #$00, #$00, #$00, 
  235.     #$36, #$36, #$F7, #$00, #$F7, #$36, #$36, #$36, 
  236.     #$18, #$18, #$FF, #$00, #$FF, #$00, #$00, #$00, 
  237.     #$00, #$00, #$00, #$00, #$00, #$00, #$00, #$00, 
  238.     #$F0, #$F0, #$F0, #$F0, #$00, #$00, #$00, #$00, 
  239.     #$0F, #$0F, #$0F, #$0F, #$00, #$00, #$00, #$00, 
  240.     #$FF, #$FF, #$FF, #$FF, #$00, #$00, #$00, #$00, 
  241.     #$00, #$00, #$00, #$00, #$F0, #$F0, #$F0, #$F0, 
  242.     #$F0, #$F0, #$F0, #$F0, #$F0, #$F0, #$F0, #$F0, 
  243.     #$0F, #$0F, #$0F, #$0F, #$F0, #$F0, #$F0, #$F0, 
  244.     #$FF, #$FF, #$FF, #$FF, #$F0, #$F0, #$F0, #$F0, 
  245.     #$00, #$00, #$00, #$00, #$0F, #$0F, #$0F, #$0F, 
  246.     #$F0, #$F0, #$F0, #$F0, #$0F, #$0F, #$0F, #$0F, 
  247.     #$0F, #$0F, #$0F, #$0F, #$0F, #$0F, #$0F, #$0F, 
  248.     #$FF, #$FF, #$FF, #$FF, #$0F, #$0F, #$0F, #$0F, 
  249.     #$00, #$00, #$00, #$00, #$FF, #$FF, #$FF, #$FF, 
  250.     #$F0, #$F0, #$F0, #$F0, #$FF, #$FF, #$FF, #$FF, 
  251.     #$0F, #$0F, #$0F, #$0F, #$FF, #$FF, #$FF, #$FF, 
  252.     #$FF, #$FF, #$FF, #$FF, #$FF, #$FF, #$FF, #$FF, 
  253.     #$00, #$00, #$76, #$DC, #$C8, #$DC, #$76, #$00, 
  254.     #$00, #$78, #$CC, #$F8, #$CC, #$F8, #$C0, #$C0, 
  255.     #$00, #$FC, #$CC, #$C0, #$C0, #$C0, #$C0, #$00, 
  256.     #$00, #$FE, #$6C, #$6C, #$6C, #$6C, #$6C, #$00, 
  257.     #$FC, #$CC, #$60, #$30, #$60, #$CC, #$FC, #$00, 
  258.     #$00, #$00, #$7E, #$D8, #$D8, #$D8, #$70, #$00, 
  259.     #$00, #$66, #$66, #$66, #$66, #$7C, #$60, #$C0, 
  260.     #$00, #$76, #$DC, #$18, #$18, #$18, #$18, #$00, 
  261.     #$FC, #$30, #$78, #$CC, #$CC, #$78, #$30, #$FC, 
  262.     #$38, #$6C, #$C6, #$FE, #$C6, #$6C, #$38, #$00, 
  263.     #$38, #$6C, #$C6, #$C6, #$6C, #$6C, #$EE, #$00, 
  264.     #$1C, #$30, #$18, #$7C, #$CC, #$CC, #$78, #$00, 
  265.     #$00, #$00, #$7E, #$DB, #$DB, #$7E, #$00, #$00, 
  266.     #$06, #$0C, #$7E, #$DB, #$DB, #$7E, #$60, #$C0, 
  267.     #$38, #$60, #$C0, #$F8, #$C0, #$60, #$38, #$00, 
  268.     #$78, #$CC, #$CC, #$CC, #$CC, #$CC, #$CC, #$00, 
  269.     #$00, #$FC, #$00, #$FC, #$00, #$FC, #$00, #$00, 
  270.     #$30, #$30, #$FC, #$30, #$30, #$00, #$FC, #$00, 
  271.     #$60, #$30, #$18, #$30, #$60, #$00, #$FC, #$00, 
  272.     #$18, #$30, #$60, #$30, #$18, #$00, #$FC, #$00, 
  273.     #$0E, #$1B, #$1B, #$18, #$18, #$18, #$18, #$18, 
  274.     #$18, #$18, #$18, #$18, #$18, #$D8, #$D8, #$70, 
  275.     #$30, #$30, #$00, #$FC, #$00, #$30, #$30, #$00, 
  276.     #$00, #$76, #$DC, #$00, #$76, #$DC, #$00, #$00, 
  277.     #$38, #$6C, #$6C, #$38, #$00, #$00, #$00, #$00, 
  278.     #$00, #$00, #$00, #$18, #$18, #$00, #$00, #$00, 
  279.     #$00, #$00, #$00, #$00, #$18, #$00, #$00, #$00, 
  280.     #$0F, #$0C, #$0C, #$0C, #$EC, #$6C, #$3C, #$1C, 
  281.     #$78, #$6C, #$6C, #$6C, #$6C, #$00, #$00, #$00, 
  282.     #$70, #$18, #$30, #$60, #$78, #$00, #$00, #$00, 
  283.     #$00, #$00, #$3C, #$3C, #$3C, #$3C, #$00, #$00, 
  284.     #$00, #$00, #$00, #$00, #$00, #$00, #$00, #$00);
  285.  
  286.   _mul = 1024;
  287.   _mul2 = 512;
  288.   maxpoints = 50;
  289.  
  290.  
  291. obj_x = 0;
  292. obj_y = 0;
  293. obj_z : integer = 250;
  294. {$i 3d.inc}
  295.  
  296.  
  297. var
  298. yofs : array[0..200] of word;
  299. sini,cosini : array[0..1000] of real;
  300. lines : array[0..maxpoints,0..1] of integer;
  301. points,rpoints : array[0..maxpoints,0..3] of integer;
  302.  
  303. procedure matriisi(var mat : t_matrix;kx2,ky2,kz2 : integer);
  304. var
  305. xa1,xa2,xa3,
  306. ya1,ya2,ya3,
  307. za1,za2,za3 : real;
  308. sinkz : real;
  309. begin
  310.   kx2 := kx2 mod 1000;
  311.   ky2 := ky2 mod 1000;
  312.   kz2 := kz2 mod 1000;
  313.   if kx2 < 0 then inc(kx2,1000);
  314.   if ky2 < 0 then inc(ky2,1000);
  315.   if kz2 < 0 then inc(kz2,1000);
  316.   sinkz := sini[kz2];
  317.   xa1 := cosini[KZ2]*cosini[KY2];
  318.   xa2 := -sinkz*cosini[KX2]-cosini[KZ2]*sini[KY2]*sini[KX2];
  319.   xa3 := sinkz*sini[KX2]-cosini[KZ2]*sini[KY2]*cosini[KX2];
  320.   ya1 := sinkz*cosini[KY2];
  321.   ya2 := cosini[KZ2]*cosini[KX2]-sinkz*sini[KY2]*sini[KX2];
  322.   ya3 := -sinkz*sini[KY2]*cosini[KX2]-cosini[KZ2]*sini[KX2];
  323.   za1 := sini[KY2];
  324.   za2 := cosini[KY2]*sini[KX2];
  325.   za3 := cosini[KY2]*cosini[KX2];
  326.   mat[0] := round(xa1*_mul);
  327.   mat[1] := round(xa2*_mul);
  328.   mat[2] := round(xa3*_mul);
  329.   mat[3] := round(ya1*_mul);
  330.   mat[4] := round(ya2*_mul);
  331.   mat[5] := round(ya3*_mul);
  332.   mat[6] := round(za1*_mul);
  333.   mat[7] := round(za2*_mul);
  334.   mat[8] := round(za3*_mul);
  335. end;
  336.  
  337. procedure rotatep;
  338. var
  339. ax_,ay,az : longint;
  340. x,y,z : longint;
  341. rx,ry : integer;
  342. n,col : integer;
  343. maxp : integer;
  344. begin
  345.   maxp := points[0,0];
  346.   for n := 1 to maxp do begin
  347.     x := points[n,0];
  348.     y := points[n,1];
  349.     z := points[n,2];
  350.     asm
  351.       mov  ax,word ptr x
  352.       imul word ptr matrix[0]
  353.       mov  cx,dx
  354.       mov  bx,ax
  355.       xor  dx,dx
  356.       mov  ax,word ptr y
  357.       imul word ptr matrix[4]
  358.       add  bx,ax
  359.       adc  cx,dx
  360.       mov  ax,word ptr z
  361.       imul word ptr matrix[8]
  362.       add  ax,bx
  363.       adc  dx,cx
  364.       shl  dx,6
  365.       shr  ax,10
  366.       add  ax,dx
  367.  
  368.       add  ax,obj_x
  369.       cwd
  370.       mov  word ptr ax_,ax
  371.       mov  word ptr ax_+2,dx
  372.  
  373.       mov  ax,word ptr x
  374.       imul word ptr matrix[12]
  375.       mov  cx,dx
  376.       mov  bx,ax
  377.       xor  dx,dx
  378.       mov  ax,word ptr y
  379.       imul word ptr matrix[16]
  380.       add  bx,ax
  381.       adc  cx,dx
  382.       mov  ax,word ptr z
  383.       imul word ptr matrix[20]
  384.       add  ax,bx
  385.       adc  dx,cx
  386.       shl  dx,6
  387.       shr  ax,10
  388.       add  ax,dx
  389.  
  390.       add  ax,obj_y
  391.       cwd
  392.       mov  word ptr ay,ax
  393.       mov  word ptr ay+2,dx
  394.  
  395.       mov  ax,word ptr x
  396.       imul word ptr matrix[24]
  397.       mov  cx,dx
  398.       mov  bx,ax
  399.       xor  dx,dx
  400.       mov  ax,word ptr y
  401.       imul word ptr matrix[28]
  402.       add  bx,ax
  403.       adc  cx,dx
  404.       mov  ax,word ptr z
  405.       imul word ptr matrix[32]
  406.       add  ax,bx
  407.       adc  dx,cx
  408.       shl  dx,6
  409.       shr  ax,10
  410.       add  ax,dx
  411.  
  412.       add  ax,obj_z
  413.       cwd
  414.       mov  word ptr az,ax
  415.       mov  word ptr az+2,dx
  416.     end;
  417.     {ax_:= (x*matrix[0] +
  418.            y*matrix[1] +
  419.            z*matrix[2]) div _mul;
  420.     ay:= (x*matrix[3]+
  421.                y*matrix[4]+
  422.                z*matrix[5]) div _mul;
  423.     az:= obj_z+(x*matrix[6]+
  424.                y*matrix[7]+
  425.                z*matrix[8]) div _mul;
  426.     rpoints[n,0] := 160+200*longint(ax_) div longint(az);
  427.     rpoints[n,1] := 100+166*longint(ay) div longint(az);
  428.     rpoints[n,2] := az;}
  429.     asm
  430.       mov  bx,n
  431.       shl  bx,3
  432.       mov  cx,word ptr az
  433.       mov  ax,120
  434.       imul word ptr ax_
  435.       idiv cx
  436.       add  ax,80
  437.       mov  word ptr rx,ax
  438.       mov  ax,100
  439.       imul word ptr ay
  440.       idiv cx
  441.       add  ax,50
  442.       mov  word ptr ry,ax
  443.       mov  [bx+offset rpoints+2],ax
  444.       mov  ax,word ptr rx
  445.       mov  [bx+offset rpoints],ax
  446.     end;
  447.   end;
  448. end;
  449.  
  450. procedure init3d;
  451. var
  452. n : integer;
  453. begin
  454.   for n := 0 to 1000 do begin
  455.     sini[n] := sin(n*pi/500);
  456.     cosini[n] := cos(n*pi/500);
  457.   end;
  458.   fillchar(points,sizeof(points),0);
  459.   fillchar(rpoints,sizeof(rpoints),0);
  460.   for n := 0 to 100 do yofs[n] := n*160;
  461. end;
  462.  
  463. procedure xline3(d,_dx,incr1,incr2,yinc,address:word;color:byte); assembler;
  464. { draw line with X as the independent variable
  465.  
  466.   d        decision variable
  467.   _dx       number of pixels in x-dimension of line
  468.   incr1    increment #1 value for decision variable
  469.   incr2    increment #2 value for decision variable
  470.   yinc     amount to add to y variable / point
  471.   address  starting offset address into display memory
  472.   color    desired color}
  473. asm
  474.   push ds
  475.   mov  ds,scr_seg
  476.  
  477. { load the working registers with the variables}
  478.   mov  di,address
  479.   mov  cx,_dx  {number of points -> cx}
  480.   mov  bx,d   {decision variable -> bx}
  481.   mov  al,color
  482.  
  483. {operational loop}
  484. @@runloop:
  485.                    {send the first point}
  486.   mov  [di],al  {write to display memory}
  487.  
  488.   inc  di          {increment x variable}
  489.  
  490.   cmp  bx,0        {d = 0 ?}
  491.   jl   @@noinc     {jump if d < 0}
  492.  
  493.                    {adjust d += incr2 + increment y += inc}
  494.   add  bx,incr2    {d = d+incr2}
  495.  
  496.   add  di,yinc     {y (address) += offset}
  497.   {jmp  @@check}
  498.                    {adjust d += incr1}
  499. @@noinc:
  500.   add  bx,incr1    {d = d+incr1}
  501.  
  502. @@check:
  503.   dec  cx
  504.   jnz  @@runloop
  505.   pop  ds
  506. end;
  507.  
  508. procedure yline3(d,dy,incr1,incr2,xinc,address,ofset:word;color:byte);
  509. assembler;
  510. {draw a line with Y as the independent variable
  511.  
  512. d       decision variable
  513. dy      # of pixels in y-dimension of line
  514. incr1   increment #1 value for decision variable
  515. incr2   increment #2 value for decision variable
  516. xinc    amount to add to x variable / point
  517. address starting offset adress of display memory
  518. ofset  display offset}
  519.  
  520. asm
  521.   push ds
  522.   mov  ds,scr_seg
  523.                      {load working registers with the variables}
  524.   mov  di,address    {load display offset address}
  525.   mov  cx,dy         {# of points -> cx}
  526.   mov  bx,d          {decision variable -> bx}
  527.   mov  ah,color
  528.  
  529. @@runloop:
  530.   mov  [di],ah    {write to display memory}
  531.  
  532.   add  di,160     {y (address) += offset (always positive)}
  533.  
  534.   cmp  bx,0          {d = 0 ?}
  535.   jl   @@noinc       {jump if d < 0}
  536.  
  537.   add  bx,incr2      {d = d+incr2}
  538.  
  539.   add  di,xinc       {inc x variable}
  540.   {jmp  @@check}
  541.  
  542. @@noinc:
  543.   add  bx,incr1      {d = d+incr1}
  544.  
  545. @@check:
  546.   dec  cx
  547.   jnz  @@runloop
  548.   pop  ds
  549. end;
  550.  
  551. procedure hline3(x1,x2,y,offset : word;color : byte);
  552. var
  553.   x,dx,address : integer;
  554.  
  555. procedure hsub3(address,_dx : word;color:byte); assembler;
  556. asm
  557.   cld
  558.   mov  es,scr_seg
  559.   mov  di,address
  560.   mov  cx,_dx
  561.   mov  al,color
  562.   rep  stosb
  563. end;
  564.  
  565. begin
  566.   if (y < 0) or (y > 99) then exit;
  567.   if x1 > x2 then begin
  568.     x := x1; x1 := x2; x2:= x;  {reverse x-coordinates}
  569.   end;
  570.   if (x1 > 159) or (x2 < 0) then exit;
  571.   if x1 < 0 then x1 := 0;
  572.   if x2 > 159 then x2 := 159;
  573.   {dx := (x2-x1)+1;
  574.   address := (y*offset)+x1;
  575.   hsub3(address,dx,color);}
  576.   asm
  577.     mov  cx,x2
  578.     sub  cx,x1
  579.     inc  cx
  580.     mov  di,y
  581.     add  di,di
  582.     mov  di,[di+offset yofs]
  583.     add  di,x1
  584.     mov  es,scr_seg
  585.     mov  al,color
  586.     rep  stosb
  587.   end;
  588. end;
  589.  
  590. procedure vline3(x,y1,y2,ofset : integer;color : byte);
  591. var
  592.   t,dy,address : integer;
  593.  
  594. procedure vsub3(address,dy,ofset : word;color : byte); assembler;
  595. asm
  596.   mov  es,scr_seg
  597.   mov  di,address
  598.   mov  cx,dy
  599.   mov  al,color
  600. @@runloop:
  601.   mov  es:[di],al
  602.   add  di,ofset
  603.   dec  cx
  604.   jnz  @@runloop
  605. end;
  606.  
  607. begin
  608.   if (x < 0) or (x > 159) then exit;
  609.   if y1 > y2 then begin
  610.     t := y2; y2 := y1; y1 := t;
  611.   end;
  612.   if (y1 > 99) or (y2 < 0) then exit;
  613.   if y1 < 0 then y1 := 0;
  614.   if y2 > 99 then y2 := 99;
  615.   {dy := y2-y1+1;}
  616.   asm
  617.     mov  es,scr_seg
  618.     mov  cx,y2
  619.     sub  cx,y1
  620.     inc  cx
  621.     mov  bx,y1
  622.     add  bx,bx
  623.     mov  di,[bx+offset yofs]
  624.     add  di,x
  625.     mov  al,color
  626. @@runloop:
  627.     mov  es:[di],al
  628.     add  di,160
  629.     dec  cx
  630.     jnz  @@runloop
  631.   end;
  632.   {vsub3(address,dy,offset,color);}
  633. end;
  634.  
  635. procedure line3(x1,y1,x2,y2 : integer;color : byte);
  636. const
  637.   offset : integer = 160;
  638. var
  639.   dx,dy,d,d2,xinc,yinc,incr1,incr2,x,y,address : integer;
  640. begin
  641.   if y1 > y2 then begin
  642.     d := x1;
  643.     x1 := x2;
  644.     x2 := d;
  645.     d := y1;
  646.     y1 := y2;
  647.     y2 := d;
  648.   end;
  649.   dx := abs(x2-x1);  {x-length}
  650.   if dx = 0 then vline3(x1,y1,y2,offset,color)
  651.   else begin
  652.     dy := abs(y2-y1);
  653.     if dy = 0 then hline3(x1,x2,y1,offset,color)
  654.     else begin    {neither horz or vert then do bresenhams}
  655.                  {is the slope between 0 and 1 ie. dy > dx}
  656.       if dx >= dy then begin     {slope < 1 quadrants 0,1,2 or 3}
  657.         if x1 > x2 then begin    {quadrant 0 or 1}
  658.           x := x2; y := y2;
  659.           if y2 > y1 then yinc := -offset  {quadrant 0}
  660.           else yinc := offset;             {quadrant 1}
  661.         end
  662.         else begin
  663.           x := x1; y := y1;
  664.           if y2 > y1 then yinc := offset   {quadrant 2}
  665.           else yinc := -offset;            {quadrant 3}
  666.         end;
  667.         address := y*offset+x;      {starting address}
  668.         d2 := dy shl 1;             {y distance times 2}
  669.         d := d2-dx;     {init the decision variable to 2*dy-dx}
  670.         incr1 := d2;        {incr. for decision var. if d < 0}
  671.         incr2 := (dy-dx) shl 1-incr1;  {incr. for decision var if d >= 0}
  672.         xline3(d,dx+1,incr1,incr2,yinc,address,color);
  673.       end
  674.       else begin     {slope > 1 quadrant 4, 5, 6 or 7}
  675.         if y1 > y2 then begin   {quadrant 4 or 5}
  676.           x := x2; y := y2;
  677.           if x > x1 then xinc := -1  {quadrant 4}
  678.           else xinc := 1;            {quadrant 5}
  679.         end
  680.         else begin
  681.           x := x1; y := y1;   {quadrant 6 or 7}
  682.           if x2 > x1 then xinc := 1    {quadrant 6}
  683.           else xinc := -1;             {quadrant 7}
  684.         end;
  685.         address := y*offset+x;
  686.         d2 := dx shl 1;         {x distance times 2}
  687.         d := d2-dy;             {decision var. = 2*dx-dy}
  688.         incr1 := d2;            {incr. for decision var, d' if d <0}
  689.         incr2 := (dx-dy) shl 1-incr1; {incr. for decision var if d >= 0}
  690.         yline3(d,dy+1,incr1,incr2,xinc,address,offset,color);
  691.       end;         {end of quadrants 0,1,2,3 or 4,5,6,7}
  692.     end;
  693.   end;
  694. end;
  695.  
  696. procedure mix; assembler;
  697. asm
  698.   push ds
  699.   mov  ds,scr_seg
  700.   mov  si,0
  701.   mov  ax,0b800h
  702.   mov  es,ax
  703.   mov  di,0
  704.   mov  dx,49
  705. @@y:
  706.   mov  cx,80
  707. @@x:
  708.   mov  ah,[si+1]
  709.   add  ah,ah
  710.   add  ah,[si]
  711.   mov  al,[si+160]
  712.   shl  al,2
  713.   add  ah,al
  714.   mov  al,[si+161]
  715.   shl  al,3
  716.   add  ah,al
  717.   add  ah,208
  718.   mov  es:[di],ah
  719.   add  si,2
  720.   add  di,2
  721.   dec  cx
  722.   jnz  @@x
  723.   add  si,160
  724.   dec  dx
  725.   jnz  @@y
  726.   pop  ds
  727. end;
  728.  
  729. procedure show;
  730. var
  731. n : integer;
  732. p1,p2 : integer;
  733. begin
  734.   for n := 1 to lines[0,0] do begin
  735.     p1 := lines[n,0];
  736.     p2 := lines[n,1];
  737.     line3(rpoints[p1,0],rpoints[p1,1],
  738.           rpoints[p2,0],rpoints[p2,1],1);
  739.   end;
  740. end;
  741.  
  742. procedure hide; assembler;
  743. asm
  744.   cld
  745.   xor  ax,ax
  746.   mov  cx,160*100/2
  747.   mov  es,scr_seg
  748.   mov  di,0
  749.   rep  stosw
  750. end;
  751.  
  752. procedure setfont; assembler;
  753. asm
  754.   push bp
  755.   mov  ax,seg fontti
  756.   mov  es,ax
  757.   mov  bp,offset fontti
  758.   mov  bx,$800
  759.   mov  dx,0
  760.   mov  cx,256
  761.   mov  ax,$1110
  762.   int  10h
  763.   pop  bp
  764. end;
  765.  
  766. procedure l3d_cube;
  767. begin
  768.   move(cubep,points,sizeof(cubep));
  769.   move(cubel,lines,sizeof(cubel));
  770.   obj_z := points[0,1];
  771. end;
  772.  
  773. procedure l3d_pyramid;
  774. begin
  775.   move(pyramidp,points,sizeof(cubep));
  776.   move(pyramidl,lines,sizeof(cubel));
  777.   obj_z := points[0,1];
  778. end;
  779.  
  780. procedure l3d_adnmod;
  781. begin
  782.   move(adnmodp,points,sizeof(adnmodp));
  783.   move(adnmodl,lines,sizeof(adnmodl));
  784.   obj_z := points[0,1];
  785. end;
  786.  
  787. procedure l3d_asm95;
  788. begin
  789.   move(asm95p,points,sizeof(asm95p));
  790.   move(asm95l,lines,sizeof(asm95l));
  791.   obj_z := points[0,1];
  792. end;
  793.  
  794.  
  795. end.
  796.